home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / tooltips / HintList.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-25  |  4.8 KB  |  179 lines
  1. unit HintList;
  2. {$ifdef Ver80} { Delphi 1.0x }
  3.   {$define DelphiLessThan3}
  4. {$endif}
  5. {$ifdef Ver90} { Delphi 2.0x }
  6.   {$define DelphiLessThan3}
  7. {$endif}
  8. {$ifdef Ver93} { C++ Builder 1.0x }
  9.   {$define DelphiLessThan3}
  10. {$endif}
  11.  
  12. interface
  13.  
  14. uses
  15.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  16.   Dialogs, StdCtrls;
  17.  
  18. type
  19.   THintListBox = class(TListBox)
  20.   private
  21.     FHintWnd: THintWindow;
  22.   protected
  23.     function CalcHintRect(MaxWidth: Integer;
  24.       const AHint: string; HintWnd: THintWindow): TRect;
  25.     procedure DoHint(X, Y: Integer);
  26.   public
  27.     procedure CMMouseEnter(var Msg: TMessage); message cm_MouseEnter;
  28.     procedure CMMouseLeave(var Msg: TMessage); message cm_MouseLeave;
  29.     procedure WMMouseMove(var Msg: TWMMouseMove); message wm_MouseMove;
  30.   end;
  31.  
  32. {$ifdef DelphiLessThan3}
  33.   { The hint window in Delphi 1 and 2 would beep if you clicked it }
  34.   { These modifications fix that }
  35.   TCustomHint = class(THintWindow)
  36.   private
  37.     procedure WMNCHitTest(var Msg: TWMNCHitTest);
  38.       message wm_NCHitTest;
  39.   protected
  40.     procedure CreateParams(var Params: TCreateParams); override;
  41.   end;
  42.  
  43. { The private routine Forms.ForegroundTask was only made }
  44. { available in Delphi 3. This is a cheap'n'nasty version of it }
  45. function ForegroundTask: Boolean;
  46. {$endif}
  47.  
  48. procedure Register;
  49.  
  50. implementation
  51.  
  52. procedure Register;
  53. begin
  54.   RegisterComponents('Clinic', [THintListBox]);
  55. end;
  56.  
  57. {$ifdef DelphiLessThan3}
  58. { The private routine Forms.ForegroundTask was only made }
  59. { available in Delphi 3. This is a cheap'n'nasty version of it }
  60. function ForegroundTask: Boolean;
  61. begin
  62.   Result := FindControl(GetActiveWindow) <> nil
  63. end;
  64. {$endif}
  65.  
  66. { THintListBox }
  67.  
  68. function THintListBox.CalcHintRect(MaxWidth: Integer; const AHint: string;
  69.   HintWnd: THintWindow): TRect;
  70. {$ifdef DelphiLessThan3}
  71. var
  72.   Buf: array[0..511] of Char;
  73. begin
  74.   Result := Rect(0, 0, MaxWidth, 0);
  75.   { Ask Windows to do the hard calculation work }
  76.   DrawText(HintWnd.Canvas.Handle, StrPCopy(Buf, AHint), -1, Result,
  77.     DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  78.   { Add some breathing room }
  79.   Inc(Result.Right, 6);
  80.   Inc(Result.Bottom, 2);
  81. {$else}
  82. begin
  83.   { Delphi 3+ makes this method available }
  84.   Result := HintWnd.CalcHintRect(Screen.Width, AHint, nil)
  85. {$endif}
  86. end;
  87.  
  88. procedure THintListBox.CMMouseEnter(var Msg: TMessage);
  89. var
  90.   Pt: TPoint;
  91. begin
  92.   GetCursorPos(Pt);
  93.   Pt := ScreenToClient(Pt);
  94.   DoHint(Pt.X, Pt.Y)
  95. end;
  96.  
  97. procedure THintListBox.CMMouseLeave(var Msg: TMessage);
  98. begin
  99.   inherited;
  100.   { Could destroy it, but this takes less time }
  101.   if Assigned(FHintWnd) then
  102.     FHintWnd.ReleaseHandle;
  103. end;
  104.  
  105. procedure THintListBox.DoHint(X, Y: Integer);
  106. const
  107.   TextOffset = 2;
  108. var
  109.   Item: Longint;
  110.   R, TmpR, OldR: TRect;
  111.   Pt: TPoint;
  112. begin
  113.   { Check item under mouse }
  114.   Item := ItemAtPos(Point(X, Y), True);
  115.   { If it is an item cell, and text is bigger than screen space, }
  116.   { and not at design-time }
  117.   Canvas.Font := Font;
  118.   if (Item >= 0) and
  119.      (Canvas.TextWidth(Items[Item]) + TextOffset > ClientWidth) and
  120.      ForegroundTask and not (csDesigning in ComponentState) then
  121.   begin
  122.     { Make sure hint window exists }
  123.     if not Assigned(FHintWnd) then
  124.     begin
  125.       FHintWnd := HintWindowClass.Create(Self);
  126.       FHintWnd.Color := Application.HintColor;
  127.     end;
  128.     { Set hint text }
  129.     Hint := Items[Item];
  130.     { Calculate rect size }
  131.     R := CalcHintRect(Screen.Width, Hint, FHintWnd);
  132.     { Find target location }
  133.     Perform(lb_GetItemRect, Item, Longint(@TmpR));
  134.     Pt := ClientToScreen(ItemRect(Item).TopLeft);
  135.     { Tweak position so it is the same as the grid cell (hopefully) }
  136.   {$ifndef DelphiLessThan3}
  137.     Dec(Pt.X);
  138.     Dec(Pt.Y, 2);
  139.   {$endif}
  140.     OffsetRect(R, Pt.X, Pt.Y - 1);
  141.     { Only draw it if it has moved - compare top-left }
  142.     { (could compare whole rect but the hint sometimes grows itself) }
  143.     GetWindowRect(FHintWnd.Handle, OldR);
  144.     if not IsWindowVisible(FHintWnd.Handle) or
  145.        not ((R.Left = OldR.Left) and (R.Top = OldR.Top)) then
  146.       FHintWnd.ActivateHint(R, Hint)
  147.   end
  148.   else
  149.     if Assigned(FHintWnd) then
  150.       FHintWnd.ReleaseHandle;
  151. end;
  152.  
  153. procedure THintListBox.WMMouseMove(var Msg: TWMMouseMove);
  154. begin
  155.   inherited;
  156.   DoHint(Msg.XPos, Msg.YPos)
  157. end;
  158.  
  159. {$ifdef DelphiLessThan3}
  160. { TCustomHint }
  161.  
  162. procedure TCustomHint.CreateParams(var Params: TCreateParams);
  163. begin
  164.   inherited CreateParams(Params);
  165.   Params.Style := Params.Style and not ws_Disabled;
  166. end;
  167.  
  168. procedure TCustomHint.WMNCHitTest(var Msg: TWMNCHitTest);
  169. begin
  170.   Msg.Result := HTTRANSPARENT;
  171. end;
  172.  
  173. initialization
  174.   Application.ShowHint := not Application.ShowHint;
  175.   HintWindowClass := TCustomHint;
  176.   Application.ShowHint := not Application.ShowHint;
  177. {$endif}
  178. end.
  179.